home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / volume1a / module1.bas < prev    next >
Encoding:
BASIC Source File  |  1997-12-02  |  10.9 KB  |  253 lines
  1. Attribute VB_Name = "Module1"
  2.       Public Const MMSYSERR_NOERROR = 0
  3.       Public Const MAXPNAMELEN = 32
  4.       Public Const MIXER_LONG_NAME_CHARS = 64
  5.       Public Const MIXER_SHORT_NAME_CHARS = 16
  6.       Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
  7.       Public Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
  8.       Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
  9.       Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
  10.       Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
  11.       
  12.       Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
  13.                      (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
  14.                      
  15.       Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _
  16.                      (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
  17.       
  18.       Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _
  19.                      (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
  20.       
  21.       Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
  22.       Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
  23.       
  24.       Public Const MIXERCONTROL_CONTROLTYPE_FADER = _
  25.                      (MIXERCONTROL_CT_CLASS_FADER Or _
  26.                      MIXERCONTROL_CT_UNITS_UNSIGNED)
  27.       
  28.       Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = _
  29.                      (MIXERCONTROL_CONTROLTYPE_FADER + 1)
  30.       
  31.       Declare Function mixerClose Lib "winmm.dll" _
  32.                      (ByVal hmx As Long) As Long
  33.          
  34.       Declare Function mixerGetControlDetails Lib "winmm.dll" _
  35.                      Alias "mixerGetControlDetailsA" _
  36.                      (ByVal hmxobj As Long, _
  37.                      pmxcd As MIXERCONTROLDETAILS, _
  38.                      ByVal fdwDetails As Long) As Long
  39.          
  40.       Declare Function mixerGetDevCaps Lib "winmm.dll" _
  41.                      Alias "mixerGetDevCapsA" _
  42.                      (ByVal uMxId As Long, _
  43.                      ByVal pmxcaps As MIXERCAPS, _
  44.                      ByVal cbmxcaps As Long) As Long
  45.          
  46.       Declare Function mixerGetID Lib "winmm.dll" _
  47.                      (ByVal hmxobj As Long, _
  48.                      pumxID As Long, _
  49.                      ByVal fdwId As Long) As Long
  50.                      
  51.       Declare Function mixerGetLineControls Lib "winmm.dll" _
  52.                      Alias "mixerGetLineControlsA" _
  53.                      (ByVal hmxobj As Long, _
  54.                      pmxlc As MIXERLINECONTROLS, _
  55.                      ByVal fdwControls As Long) As Long
  56.                      
  57.       Declare Function mixerGetLineInfo Lib "winmm.dll" _
  58.                      Alias "mixerGetLineInfoA" _
  59.                      (ByVal hmxobj As Long, _
  60.                      pmxl As MIXERLINE, _
  61.                      ByVal fdwInfo As Long) As Long
  62.                      
  63.       Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
  64.       
  65.       Declare Function mixerMessage Lib "winmm.dll" _
  66.                      (ByVal hmx As Long, _
  67.                      ByVal uMsg As Long, _
  68.                      ByVal dwParam1 As Long, _
  69.                      ByVal dwParam2 As Long) As Long
  70.                      
  71.       Declare Function mixerOpen Lib "winmm.dll" _
  72.                      (phmx As Long, _
  73.                      ByVal uMxId As Long, _
  74.                      ByVal dwCallback As Long, _
  75.                      ByVal dwInstance As Long, _
  76.                      ByVal fdwOpen As Long) As Long
  77.                      
  78.       Declare Function mixerSetControlDetails Lib "winmm.dll" _
  79.                      (ByVal hmxobj As Long, _
  80.                      pmxcd As MIXERCONTROLDETAILS, _
  81.                      ByVal fdwDetails As Long) As Long
  82.                      
  83.       Declare Sub CopyStructFromPtr Lib "kernel32" _
  84.                      Alias "RtlMoveMemory" _
  85.                      (struct As Any, _
  86.                      ByVal ptr As Long, ByVal cb As Long)
  87.                      
  88.       Declare Sub CopyPtrFromStruct Lib "kernel32" _
  89.                      Alias "RtlMoveMemory" _
  90.                      (ByVal ptr As Long, _
  91.                      struct As Any, _
  92.                      ByVal cb As Long)
  93.                      
  94.       Declare Function GlobalAlloc Lib "kernel32" _
  95.                      (ByVal wFlags As Long, _
  96.                      ByVal dwBytes As Long) As Long
  97.                      
  98.       Declare Function GlobalLock Lib "kernel32" _
  99.                      (ByVal hmem As Long) As Long
  100.                      
  101.       Declare Function GlobalFree Lib "kernel32" _
  102.                      (ByVal hmem As Long) As Long
  103.       
  104.       Type MIXERCAPS
  105.          wMid As Integer                   '  manufacturer id
  106.          wPid As Integer                   '  product id
  107.          vDriverVersion As Long            '  version of the driver
  108.          szPname As String * MAXPNAMELEN   '  product name
  109.          fdwSupport As Long                '  misc. support bits
  110.          cDestinations As Long             '  count of destinations
  111.       End Type
  112.       
  113.       Type MIXERCONTROL
  114.          cbStruct As Long           '  size in Byte of MIXERCONTROL
  115.          dwControlID As Long        '  unique control id for mixer device
  116.          dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx
  117.          fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx
  118.          cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE set
  119.          szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control
  120.          szName As String * MIXER_LONG_NAME_CHARS        ' long name of control
  121.          lMinimum As Long           '  Minimum value
  122.          lMaximum As Long           '  Maximum value
  123.          reserved(10) As Long       '  reserved structure space
  124.          End Type
  125.       
  126.       Type MIXERCONTROLDETAILS
  127.          cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS
  128.          dwControlID As Long    '  control id to get/set details on
  129.          cChannels As Long      '  number of channels in paDetails array
  130.          item As Long           '  hwndOwner or cMultipleItems
  131.          cbDetails As Long      '  size of _one_ details_XX struct
  132.          paDetails As Long      '  pointer to array of details_XX structs
  133.       End Type
  134.       
  135.       Type MIXERCONTROLDETAILS_UNSIGNED
  136.          dwValue As Long        '  value of the control
  137.       End Type
  138.       
  139.       Type MIXERLINE
  140.          cbStruct As Long               '  size of MIXERLINE structure
  141.          dwDestination As Long          '  zero based destination index
  142.          dwSource As Long               '  zero based source index (if source)
  143.          dwLineID As Long               '  unique line id for mixer device
  144.          fdwLine As Long                '  state/information about line
  145.          dwUser As Long                 '  driver specific information
  146.          dwComponentType As Long        '  component type line connects to
  147.          cChannels As Long              '  number of channels line supports
  148.          cConnections As Long           '  number of connections (possible)
  149.          cControls As Long              '  number of controls at this line
  150.          szShortName As String * MIXER_SHORT_NAME_CHARS
  151.          szName As String * MIXER_LONG_NAME_CHARS
  152.          dwType As Long
  153.          dwDeviceID As Long
  154.          wMid  As Integer
  155.          wPid As Integer
  156.          vDriverVersion As Long
  157.          szPname As String * MAXPNAMELEN
  158.       End Type
  159.       
  160.       Type MIXERLINECONTROLS
  161.          cbStruct As Long       '  size in Byte of MIXERLINECONTROLS
  162.          dwLineID As Long       '  line id (from MIXERLINE.dwLineID)
  163.                                 '  MIXER_GETLINECONTROLSF_ONEBYID or
  164.          dwControl As Long      '  MIXER_GETLINECONTROLSF_ONEBYTYPE
  165.          cControls As Long      '  count of controls pmxctrl points to
  166.          cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL
  167.          pamxctrl As Long       '  pointer to first MIXERCONTROL array
  168.       End Type
  169.       
  170.       Function GetVolumeControl(ByVal hmixer As Long, _
  171.                               ByVal componentType As Long, _
  172.                               ByVal ctrlType As Long, _
  173.                               ByRef mxc As MIXERCONTROL) As Boolean
  174.                               
  175.       ' This function attempts to obtain a mixer control. Returns True if successful.
  176.          Dim mxlc As MIXERLINECONTROLS
  177.          Dim mxl As MIXERLINE
  178.          Dim hmem As Long
  179.          Dim rc As Long
  180.              
  181.          mxl.cbStruct = Len(mxl)
  182.          mxl.dwComponentType = componentType
  183.       
  184.          ' Obtain a line corresponding to the component type
  185.          rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
  186.          
  187.          If (MMSYSERR_NOERROR = rc) Then
  188.              mxlc.cbStruct = Len(mxlc)
  189.              mxlc.dwLineID = mxl.dwLineID
  190.              mxlc.dwControl = ctrlType
  191.              mxlc.cControls = 1
  192.              mxlc.cbmxctrl = Len(mxc)
  193.              
  194.              ' Allocate a buffer for the control
  195.              hmem = GlobalAlloc(&H40, Len(mxc))
  196.              mxlc.pamxctrl = GlobalLock(hmem)
  197.              mxc.cbStruct = Len(mxc)
  198.              
  199.              ' Get the control
  200.              rc = mixerGetLineControls(hmixer, _
  201.                                        mxlc, _
  202.                                        MIXER_GETLINECONTROLSF_ONEBYTYPE)
  203.                   
  204.              If (MMSYSERR_NOERROR = rc) Then
  205.                  GetVolumeControl = True
  206.                  
  207.                  ' Copy the control into the destination structure
  208.                  CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
  209.              Else
  210.                  GetVolumeControl = False
  211.              End If
  212.              GlobalFree (hmem)
  213.              Exit Function
  214.          End If
  215.       
  216.          GetVolumeControl = False
  217.       End Function
  218.       
  219.       Function SetVolumeControl(ByVal hmixer As Long, _
  220.                               mxc As MIXERCONTROL, _
  221.                               ByVal volume As Long) As Boolean
  222.       'This function sets the value for a volume control. Returns True if successful
  223.                               
  224.          Dim mxcd As MIXERCONTROLDETAILS
  225.          Dim vol As MIXERCONTROLDETAILS_UNSIGNED
  226.       
  227.          mxcd.item = 0
  228.          mxcd.dwControlID = mxc.dwControlID
  229.          mxcd.cbStruct = Len(mxcd)
  230.          mxcd.cbDetails = Len(vol)
  231.          
  232.          ' Allocate a buffer for the control value buffer
  233.          hmem = GlobalAlloc(&H40, Len(vol))
  234.          mxcd.paDetails = GlobalLock(hmem)
  235.          mxcd.cChannels = 1
  236.          vol.dwValue = volume
  237.          
  238.          ' Copy the data into the control value buffer
  239.          CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
  240.          
  241.          ' Set the control value
  242.          rc = mixerSetControlDetails(hmixer, _
  243.                                     mxcd, _
  244.                                     MIXER_SETCONTROLDETAILSF_VALUE)
  245.          
  246.          GlobalFree (hmem)
  247.          If (MMSYSERR_NOERROR = rc) Then
  248.              SetVolumeControl = True
  249.          Else
  250.              SetVolumeControl = False
  251.          End If
  252.       End Function
  253.